Group Predictions

Row

Win percentage for the week

Season Win Percentage

Games Correct

150

Games Picked

220

Number of predictions

12

Row

This Week’s Predictions
Game Prediction Winner Correct Correct Votes Correct Percent
1 Tampa Bay Buccaneers Atlanta Falcons No 0 0.0000
2 Cincinnati Bengals Baltimore Ravens No 4 0.3333
3 Houston Texans Houston Texans Yes 12 1.0000
4 Tie Buffalo Bills -- 6 0.5000
5 Chicago Bears Chicago Bears Yes 11 0.9167
6 Tie Los Angeles Chargers -- 6 0.5000
7 Philadelphia Eagles Philadelphia Eagles Yes 11 0.9167
8 Jacksonville Jaguars Jacksonville Jaguars Yes 12 1.0000
9 New York Giants Washington Commanders No 3 0.2500
10 Carolina Panthers New Orleans Saints No 2 0.1667
11 Los Angeles Rams Los Angeles Rams Yes 9 0.7500
12 Denver Broncos Denver Broncos Yes 8 0.6667
13 Seattle Seahawks Seattle Seahawks Yes 11 0.9167
14 San Francisco 49ers San Francisco 49ers Yes 12 1.0000
15 Dallas Cowboys Minnesota Vikings No 1 0.0833
16 Pittsburgh Steelers Pittsburgh Steelers Yes 10 0.8333

Individual Predictions

row

Individual Table

Individual Results
Week 15
Name
Weekly # Correct
Percent Weeks Picked Season Percent Adj Season Percent Season Trend
Week 1 Week 2 Week 3 Week 4 Week 5 Week 6 Week 7 Week 8 Week 9 Week 10 Week 11 Week 12 Week 13 Week 14 Week 15
Adrienne Saltik NA 12 11 8 9 10 10 6 11 NA 13 8 10 10 12 0.7500 13 0.6842 0.5930
Christina Neal 9 8 7 5 NA NA NA NA NA NA 12 NA 10 12 12 0.7500 8 0.6198 0.3306
Elliott Clark 9 11 8 9 7 10 11 8 9 9 12 10 11 6 11 0.6875 15 0.6409 0.6409
Daniel Baller 11 12 10 10 5 9 11 9 8 8 8 10 NA 8 11 0.6875 14 0.6373 0.5948
Michael Hoffman 11 8 13 10 4 9 11 9 4 10 9 10 9 9 11 0.6875 15 0.6227 0.6227
Dylan Soule 8 13 8 11 NA NA 13 NA 9 9 11 9 10 7 10 0.6250 12 0.6629 0.5303
Justin Hartung 12 11 10 9 NA 7 11 7 11 9 7 6 10 9 10 0.6250 14 0.6262 0.5845
Mariah Boyce 10 12 9 7 6 10 5 5 NA 7 10 8 10 7 9 0.5625 14 0.5583 0.5211
Harold Sampson 12 12 10 11 5 9 12 9 9 9 12 12 10 5 8 0.5000 15 0.6591 0.6591
Angus Ferrell 9 12 10 NA NA 11 10 9 11 11 8 9 10 6 8 0.5000 13 0.6526 0.5656
Justin Mclellan 12 12 10 7 6 11 12 7 9 8 9 10 8 10 8 0.5000 15 0.6318 0.6318
Abby Wilton 9 11 NA 7 5 10 12 8 10 8 8 12 10 9 8 0.5000 14 0.6165 0.5754
Peter Previte 12 12 10 10 NA NA NA NA NA NA NA NA NA NA NA 0.0000 4 0.7097 0.1893
Brandon Des Jardins 14 12 12 10 3 NA 13 9 9 10 12 NA NA NA NA 0.0000 10 0.7075 0.4717
Bradley Whitehall 6 11 12 10 9 9 11 11 NA 10 14 11 NA NA NA 0.0000 11 0.7037 0.5160
Christina Shumate 14 11 12 8 8 NA NA NA NA NA NA NA NA NA NA 0.0000 5 0.6974 0.2325
Brenna Friedel 11 11 NA NA NA NA NA NA NA NA NA NA NA NA NA 0.0000 2 0.6875 0.0917
Sean Fraser 9 12 9 9 7 NA 9 8 10 10 13 9 NA NA NA 0.0000 11 0.6522 0.4783
Peter Meyers 14 13 9 7 5 11 11 5 NA NA NA NA NA NA NA 0.0000 8 0.6303 0.3362
Grace Chao 10 13 9 9 7 9 NA 7 10 NA NA NA NA NA NA 0.0000 8 0.6271 0.3345
Matthew Lohff 11 13 10 9 NA 9 9 6 8 9 NA NA NA 8 NA 0.0000 10 0.6259 0.4173
Kraig Sheetz 10 NA 10 NA 6 NA 10 7 NA 10 NA NA NA NA NA 0.0000 6 0.6163 0.2465
Aaron Johnston 12 11 10 7 8 7 10 8 NA NA NA NA NA 8 NA 0.0000 9 0.6090 0.3654
Bonvie Fosam 11 11 NA 9 5 7 10 8 12 4 10 10 NA 9 NA 0.0000 12 0.6023 0.4818
Benjamin Siegel 12 11 9 8 6 8 10 NA 8 NA NA NA NA NA NA 0.0000 8 0.6000 0.3200
Mary Beth Inks 11 NA 10 NA 6 NA 11 8 9 5 9 8 8 NA NA 0.0000 10 0.5862 0.3908
Lucas Miller 11 9 NA 10 6 9 NA NA NA NA NA NA NA 8 NA 0.0000 6 0.5824 0.2330
Roni Brown 6 NA 10 NA 7 NA NA NA 10 NA NA NA NA 7 NA 0.0000 5 0.5556 0.1852
Elisa Sun 11 NA NA NA 5 NA NA NA NA NA NA NA NA NA NA 0.0000 2 0.5333 0.0711

Season Leaderboard

Season Leaderboard (Season Percent)
Week 15
Season Rank Name Donuts Won Weeks Picked Season Percent Adj Season Percent Season Trend
1 Peter Previte 0 4 0.7097 0.1893
2 Brandon Des Jardins 2 10 0.7075 0.4717
3 Bradley Whitehall 3 11 0.7037 0.5160
4 Christina Shumate 1 5 0.6974 0.2325
5 Brenna Friedel 0 2 0.6875 0.0917
6 Adrienne Saltik 2 13 0.6842 0.5930
7 Dylan Soule 3 12 0.6629 0.5303
8 Harold Sampson 2 15 0.6591 0.6591
9 Angus Ferrell 2 13 0.6526 0.5656
10 Sean Fraser 0 11 0.6522 0.4783
11 Elliott Clark 1 15 0.6409 0.6409
12 Daniel Baller 0 14 0.6373 0.5948
13 Justin Mclellan 1 15 0.6318 0.6318
14 Peter Meyers 3 8 0.6303 0.3362
15 Grace Chao 1 8 0.6271 0.3345
16 Justin Hartung 0 14 0.6262 0.5845
17 Matthew Lohff 1 10 0.6259 0.4173
18 Michael Hoffman 1 15 0.6227 0.6227
19 Christina Neal 2 8 0.6198 0.3306
20 Abby Wilton 1 14 0.6165 0.5754
21 Kraig Sheetz 0 6 0.6163 0.2465
22 Aaron Johnston 0 9 0.6090 0.3654
23 Bonvie Fosam 1 12 0.6023 0.4818
24 Benjamin Siegel 0 8 0.6000 0.3200
25 Mary Beth Inks 0 10 0.5862 0.3908
26 Lucas Miller 0 6 0.5824 0.2330
27 Mariah Boyce 0 14 0.5583 0.5211
28 Roni Brown 0 5 0.5556 0.1852
29 Elisa Sun 0 2 0.5333 0.0711

Adjusted Season Leaderboard

Season Leaderboard (Adjusted Season Percent)
Week 15
Season Rank Name Donuts Won Weeks Picked Season Percent Adj Season Percent Season Trend
1 Harold Sampson 2 15 0.6591 0.6591
2 Elliott Clark 1 15 0.6409 0.6409
3 Justin Mclellan 1 15 0.6318 0.6318
4 Michael Hoffman 1 15 0.6227 0.6227
5 Daniel Baller 0 14 0.6373 0.5948
6 Adrienne Saltik 2 13 0.6842 0.5930
7 Justin Hartung 0 14 0.6262 0.5845
8 Abby Wilton 1 14 0.6165 0.5754
9 Angus Ferrell 2 13 0.6526 0.5656
10 Dylan Soule 3 12 0.6629 0.5303
11 Mariah Boyce 0 14 0.5583 0.5211
12 Bradley Whitehall 3 11 0.7037 0.5160
13 Bonvie Fosam 1 12 0.6023 0.4818
14 Sean Fraser 0 11 0.6522 0.4783
15 Brandon Des Jardins 2 10 0.7075 0.4717
16 Matthew Lohff 1 10 0.6259 0.4173
17 Mary Beth Inks 0 10 0.5862 0.3908
18 Aaron Johnston 0 9 0.6090 0.3654
19 Peter Meyers 3 8 0.6303 0.3362
20 Grace Chao 1 8 0.6271 0.3345
21 Christina Neal 2 8 0.6198 0.3306
22 Benjamin Siegel 0 8 0.6000 0.3200
23 Kraig Sheetz 0 6 0.6163 0.2465
24 Lucas Miller 0 6 0.5824 0.2330
25 Christina Shumate 1 5 0.6974 0.2325
26 Peter Previte 0 4 0.7097 0.1893
27 Roni Brown 0 5 0.5556 0.1852
28 Brenna Friedel 0 2 0.6875 0.0917
29 Elisa Sun 0 2 0.5333 0.0711

Data

---
title: "2025 NFL Moneyline Picks"
output: 
  flexdashboard::flex_dashboard:
    theme:
      version: 4
      bootswatch: spacelab
    orientation: rows
    vertical_layout: fill
    social: ["menu"]
    source_code: embed
    navbar:
      - { title: "Created by: Daniel Baller", icon: "fa-github", href: "https://github.com/danielpballer"  }
---


```{r setup, include=FALSE}
#    source_code: embed
options(show.error.messages = FALSE)
library(flexdashboard)
library(tidyverse)
library(data.table)
library(formattable)
library(ggpubr)
library(ggrepel)
library(gt)
library(glue)
library(ggthemes)
library(hrbrthemes)
library(sparkline)
library(plotly)
library(htmlwidgets)
#library(mdthemes)
library(ggtext)
library(ggnewscale)
library(DT)
source("./Functions/functions2.R")

thematic::thematic_rmd(font = "auto")

# Use line 211 if you need to hard code any losses for a week
```

```{r Reading in our picks files, include=FALSE}
current_week = 15 #Set what week it is
week_1 = read_csv("./CSV_Data_Files/2025 NFL Week 1.csv")%>% 
  mutate(Name = str_to_title(Name))
week_2 = read_csv("./CSV_Data_Files/2025 NFL Week 2.csv")%>% 
 mutate(Name = str_to_title(Name))
week_3 = read_csv("./CSV_Data_Files/2025 NFL Week 3.csv")%>% 
 mutate(Name = str_to_title(Name))
week_4 = read_csv("./CSV_Data_Files/2025 NFL Week 4.csv")%>%
 mutate(Name = str_to_title(Name))
week_5 = read_csv("./CSV_Data_Files/2025 NFL Week 5.csv")%>% 
 mutate(Name = str_to_title(Name))
week_6 = read_csv("./CSV_Data_Files/2025 NFL Week 6.csv")%>% 
 mutate(Name = str_to_title(Name))
week_7 = read_csv("./CSV_Data_Files/2025 NFL Week 7.csv")%>% 
 mutate(Name = str_to_title(Name))
week_8 = read_csv("./CSV_Data_Files/2025 NFL Week 8.csv")%>% 
 mutate(Name = str_to_title(Name))
week_9 = read_csv("./CSV_Data_Files/2025 NFL Week 9.csv")%>% 
 mutate(Name = str_to_title(Name))
week_10 = read_csv("./CSV_Data_Files/2025 NFL Week 10.csv")%>% 
 mutate(Name = str_to_title(Name))
week_11 = read_csv("./CSV_Data_Files/2025 NFL Week 11.csv")%>% 
 mutate(Name = str_to_title(Name))
week_12 = read_csv("./CSV_Data_Files/2025 NFL Week 12.csv")%>% 
 mutate(Name = str_to_title(Name))
week_13 = read_csv("./CSV_Data_Files/2025 NFL Week 13.csv")%>% 
 mutate(Name = str_to_title(Name))
week_14 = read_csv("./CSV_Data_Files/2025 NFL Week 14.csv")%>% 
 mutate(Name = str_to_title(Name))
week_15 = read_csv("./CSV_Data_Files/2025 NFL Week 15.csv")%>% 
 mutate(Name = str_to_title(Name))
# week_16 = read_csv("./CSV_Data_Files/2024 NFL Week 16.csv")%>% 
#   mutate(Name = str_to_title(Name))
# week_17 = read_csv("./CSV_Data_Files/2024 NFL Week 17.csv")%>% 
#   mutate(Name = str_to_title(Name))
# week_18 = read_csv("./CSV_Data_Files/2024 NFL Week 18.csv")%>% 
#   mutate(Name = str_to_title(Name))
# week_19 = read_csv("./CSV_Data_Files/2024 NFL Wild Card.csv")%>% 
#   mutate(Name = str_to_title(Name))
# week_20 = read_csv("./CSV_Data_Files/2024 NFL Divisional Week.csv")%>% 
#   mutate(Name = str_to_title(Name))
# week_21 = read_csv("./CSV_Data_Files/2024 NFL Conference Round.csv")%>% 
# mutate(Name = str_to_title(Name))
# week_22 = read_csv("./CSV_Data_Files/2024 NFL Super Bowl.csv")%>% 
#   mutate(Name = str_to_title(Name))

#reading in scores
Scores = read_csv(glue::glue("./CSV_Data_Files/NFL_Scores_{current_week}.csv")) 

#reading in CBS Prediction Records
cbs = read_csv(glue::glue("./CSV_Data_Files/CBS_Experts_{current_week}.csv")) %>% 
  mutate(Percent = round(Percent,4))
cbs_season = read_csv(glue::glue("./CSV_Data_Files/CBS_Experts_Season_{current_week}.csv"))

#reading in ESPN Prediction Records
espn = read_csv(glue::glue("./CSV_Data_Files/ESPN_Experts_{current_week}.csv"))%>% 
  mutate(Percent = round(Percent,4))
espn_season = read_csv(glue::glue("./CSV_Data_Files/ESPN_Experts_Season_{current_week}.csv"))%>% 
  mutate(Percent = round(Percent,4))

#Odds not working for the 2024 season.  Need to fix scrape code for next year.
#Reading in the moneyline odds for each team and cleaning the team names
# odds_wk1 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_1.csv"))
# odds_wk2 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_2.csv"))
# odds_wk3 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_3.csv"))
# odds_wk4 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_4.csv"))
# odds_wk5 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_5.csv"))
# odds_wk6 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_6.csv"))
# odds_wk7 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_7.csv"))
# odds_wk8 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_8.csv"))
# odds_wk9 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_9.csv"))
# odds_wk10 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_10.csv"))
# odds_wk11 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_11.csv"))
# odds_wk12 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_12.csv"))
# odds_wk13 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_13.csv"))
# odds_wk14 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_14.csv"))
# odds_wk15 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_15.csv"))
# odds_wk16 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_16.csv"))
# odds_wk17 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_17.csv"))
# odds_wk18 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_18.csv"))
# odds_wk19 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_19.csv"))
# odds_wk20 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_20.csv"))
# odds_wk21 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_21.csv"))
# odds_wk22 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_22.csv"))

####################UPDATE THESE###############################
inst.picks = list(week_1, week_2, week_3, week_4, week_5, week_6, week_7, week_8, week_9, week_10, week_11, week_12, week_13, week_14, week_15)#, week_16, week_17, week_18, week_19, week_20, week_21, week_22) #add in the additional weeks
#odds = rbind(odds_wk1, odds_wk2, odds_wk3, odds_wk4, odds_wk5, odds_wk6, odds_wk7, odds_wk8,
#              odds_wk9, odds_wk10, odds_wk11, odds_wk12) #add in the additional weeks
####################END OF UPDATE##############################

weeks = as.list(seq(1:current_week)) #creating a list of each week number
```

```{r read in scores clean data, include=FALSE}
#Cleaning Odds Data
# cl_odds = odds_cleaning(odds)

#Cleaning scores data
Scores = cleaning2(Scores)

#creating a list of winners for each week
winners = map(weeks, weekly_winners)

#creating a vector of this weeks winners
this_week = pull(winners[[length(winners)]])  

#Getting the number of games for each week
weekly_number_of_games = map_dbl(weeks, week_number_games)
```

```{r Group Predictions, include=FALSE}
#Creating the list of everyones predictions each week.
games = map(inst.picks, games_fn)

#Creating the prediction table.  
pred_table = map(games, pred_table_fn)

#Adding who won to the predictions
with_winners = map2(pred_table, winners, adding_winners)

#Creating results for each week.
results = map2(with_winners,weekly_number_of_games, results_fn)
```


```{r Displaying Group Results, echo=FALSE}
#Displaying the group results

inst_group_table = results[[length(results)]] %>% gt() %>% 
  cols_align(
    align = "center") %>% 
   tab_header(
    title = md("This Week's Predictions"),
    #subtitle = md(glue("Week {length(results)}"))
    ) %>% 
   tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(Correct),
      rows = Correct =="No"
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(Correct),
      rows = Correct =="Yes"
    )) %>% 
  tab_options(
    data_row.padding = px(3),
    container.height = "100%"
   )
```

```{r Weekly and season Group Results, include=FALSE}
# Printing the weekly and season win percentage     

#how many games correct, incorrect, and not picked each week
weekly_group_correct = map(results, weekly_group_correct_fn)  

#how many games were picked each week
weekly_games_picked = map2(weekly_group_correct, weekly_number_of_games, weekly_games_picked_fn)

#Calculating the number of correct picks for each week
weekly_group_correct_picks = map(weekly_group_correct, weekly_group_correct_picks_fn)

# Code to manually hard code in week where we get 0 games correct
# ##### Remove this line before next season 
#weekly_group_correct_picks[[21]]=0

#Calculating weekly win percentage
weekly_win_percentage = map2(weekly_group_correct_picks, weekly_games_picked, weekly_win_percentage_fn)

#Calculating season win percentage
season_win_percentage = round(sum(unlist(weekly_group_correct_picks))/sum(unlist(weekly_games_picked)),4)

#Calculating number of games picked this season
season_games = sum(unlist(weekly_games_picked))

#calculating season wins
season_wins = sum(unlist(weekly_group_correct_picks))

#calculating the number of people who picked this week
Total = dim(inst.picks[[length(weeks)]])[1]
```

```{r plotting group results, include=FALSE}
#Previous Weeks
group_season_for_plotting = unlist(weekly_win_percentage) %>% as.data.frame() %>% 
  rename(`Win Percentage` = ".") %>% 
  add_column(Week = unlist(weeks))
```

```{r Plotting the group results, echo=FALSE}
inst_group_season_plot = group_season_for_plotting %>% 
ggplot(aes(x = as.factor(Week), y = `Win Percentage`))+
  geom_point()+
  geom_path(aes(x = Week))+
  ylim(c(0, 1)) +
  xlab("NFL Week") + 
  ylab("Correct Percentage")+
  ggtitle("Weekly Group Correct Percentage")+
  theme_classic()+
  theme(plot.title = element_text(hjust = 0.5, size = 18))
```

```{r beating cbs week, include=FALSE}
#Creating a list of correct percentages for each week.
cbs_weekly_percent = map(weeks, cbs_percent)

#Creating a list of how many cbs experts we beat each week.
cbs_experts_beat = map2(cbs_weekly_percent, weekly_win_percentage, experts_beat)

#Creating a list of how many cbs experts picked each week.  
cbs_experts_total = map(cbs_weekly_percent, experts_tot)
```

```{r beating cbs season, include=FALSE}
#Creating a list of correct percentages for each week.
cbs_season_percent = map(weeks, cbs_season_percent)

#Creating a list of how many cbs experts we beat each week.
cbs_experts_beat_season = map2(cbs_season_percent, season_win_percentage, experts_beat)

#Creating a list of how many cbs experts picked each week.  
cbs_experts_season_total = map(cbs_season_percent, experts_tot)
```

```{r beating ESPN week, include=FALSE}
#Creating a list of correct percentages for each week.
espn_weekly_percent = map(weeks, espn_percent)

#Creating a list of how many cbs experts we beat each week.
espn_experts_beat = map2(espn_weekly_percent, weekly_win_percentage, experts_beat)

#Creating a list of how many cbs experts picked each week.  
espn_experts_total = map(espn_weekly_percent, experts_tot)
```

```{r beating ESPN season, include=FALSE}
#Creating a list of correct percentages for each week.
espn_season_percent = map(weeks, espn_season_percent)

#Creating a list of how many cbs experts we beat each week.
espn_experts_beat_season = map2(espn_season_percent, season_win_percentage, experts_beat)

#Creating a list of how many cbs experts picked each week.  
espn_experts_season_total = map(espn_season_percent, experts_tot)
```

```{r individual results, include=FALSE}
#Creating a list of individual results for each week.
weekly_indiv = pmap(list(inst.picks, winners, weeks), indiv_weekly_pred)

#Combining each week into one dataframe and calculating percentage Correct for this week.  
full_season = weekly_indiv %>% reduce(full_join, by = "Name") %>% 
  mutate(Percent = round(pull(.[,ncol(.)]/weekly_number_of_games[[length(weekly_number_of_games)]]),4)) 

#Creating a dataframe with only the weekly picks
a = full_season %>% select(starts_with("Week"))

#Creating a vector of how many weeks each person picked over the season
tot_week = NULL
help = NULL
for (i in 1:dim(a)[1]){
  for(j in 1:length(a)){
    help[j] = ifelse(is.na(a[i,j])==T,0,1)
    tot_week[i] = sum(help)
  }
}

#Creating a vector of how many games each person picked over the season
tot_picks= NULL
help = NULL
for (i in 1:dim(a)[1]){
  for(j in 1:length(a)){
    help[j] = unlist(weekly_games_picked)[j]*ifelse(is.na(a[i,j])==T,0,1)
    tot_picks[i] = sum(help)
  }
}

#Creatign a vector of how many games each person picked correct over the season
tot_correct = NULL
help = NULL
for (i in 1:dim(a)[1]){
  tot_correct[i] = sum(a[i,], na.rm = T)
}

#adding how many weeks each person picked, season correct percentage, and adjusted season percentag to the data frame and sorting the data
indiv_disp = full_season %>% add_column(`Weeks Picked` = tot_week) %>%
  add_column(tot_correct)%>%
  add_column(tot_picks)%>%
  mutate(`Season Percent` = round(tot_correct/tot_picks,4))%>%
  mutate(`Adj Season Percent` = round(`Season Percent`*(tot_week/length(a)),4)) %>%
  select(-tot_correct, -tot_picks) %>%
  arrange(desc(Percent), desc(`Season Percent`)) %>%
  mutate(Percent = ifelse(is.na(Percent)==T, 0, Percent))
```


```{r individual percentages, include=FALSE}
#Calculating individual percentages for each week.
weekly_indiv_percent = map2(weekly_indiv, as.list(weekly_number_of_games), indiv_percent) %>% reduce(full_join, by = "Name")

weekly_indiv_percent_plot = weekly_indiv_percent %>% 
  pivot_longer(cols = starts_with("Week"), names_to = "Week", values_to = "Percent")%>%
  mutate(Percent = ifelse(is.na(Percent)==T, 0, Percent)) %>% 
  mutate(Week = as.factor(Week))

levels = NULL
for(i in 1:length(weeks)){
  levels[i] = glue("Week {i}")  
}

weekly_indiv_percent_plot = weekly_indiv_percent_plot %>%
  mutate(Week = factor(Week, levels))
```

```{r sparklines, include=FALSE}
#adding sparklines
plot_group = function(name, df){
  plot_object = 
    ggplot(data = df,
           aes(x = as.factor(Week), y=Percent, group = 1))+
    geom_path(size = 7)+
    scale_y_continuous(limits = c(0,1))+
    theme_void()+
    theme(legend.position = "none")
  return(plot_object)
}

sparklines = 
  weekly_indiv_percent_plot %>% 
  group_by(Name) %>% 
  nest() %>% 
  mutate(plot = map2(Name, data, plot_group)) %>% 
  select(-data)
  
indiv_disp_2 = indiv_disp %>% 
  inner_join(sparklines, by = "Name") %>% 
  mutate(`Season Trend` = NA)
```

```{r Printing Individual Table2, echo=FALSE}
# Printing the individual Table
indiv_table = indiv_disp_2 %>% gt() %>% 
  cols_align(
    align = "center") %>% 
   tab_header(
    title = md("Individual Results"),
    subtitle = md(glue("Week {length(weeks)}"))
    ) %>% 
   tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(Percent),
      rows = Percent<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(Percent),
      rows = Percent>.5
    )) %>% 
     tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`>.5
    ))%>% 
     tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`>.5
    )) %>% 
  tab_options(
    container.width = pct(100),
    data_row.padding = px(1),
    container.height = "100%"
   ) %>%
    tab_spanner(
    label = "Weekly # Correct",
    columns = starts_with(c("Week "))
  ) %>% 
  text_transform(
    locations = cells_body(c(`Season Trend`)),
    fn = function(x){
      map(indiv_disp_2$plot, ggplot_image, height = px(30), aspect_ratio = 4)
                 }) %>%
  cols_hide(c(plot))

indiv_winners = indiv_disp_2 %>% filter(Percent == max(Percent)) %>% select(Name) %>% pull() %>% paste(collapse = ", ")
indiv_season = indiv_disp_2 %>% filter(`Season Percent` == max(`Season Percent`)) %>% select(Name) %>% pull() %>% paste(collapse = ", ")
indiv_season_adj = indiv_disp_2 %>% filter(`Adj Season Percent` == max(`Adj Season Percent`)) %>% select(Name) %>% pull()%>% paste(collapse = ", ")
```

```{r Printing Season Leaderboard, echo=FALSE}
# Printing the Season Leaderboard
  
season_leaderboard_disp = indiv_disp_2 %>% select(Name, starts_with("Week ")) %>% 
  pivot_longer(starts_with("Week"),names_to = "Week", values_to = "Correct") %>% 
  group_by(Week) %>% 
  mutate(Correct = case_when(is.na(Correct)==T~0, 
                             TRUE~Correct)) %>% 
  mutate(Donut = case_when(Correct==max(Correct)~1,
                           TRUE~0))  %>% 
  ungroup() %>% 
  group_by(Name) %>% 
  summarise(`Donuts Won` = sum(Donut)) %>% 
  #mutate(`Donuts Won` = strrep("award,", Donuts)) %>% 
  right_join(.,indiv_disp_2) %>% 
  select(-starts_with("Week "), -Percent) %>% 
  mutate(`Season Rank` = min_rank(desc(`Season Percent`)),.before = Name) %>% 
  arrange(`Season Rank`) 
  
season_leaderboard = season_leaderboard_disp %>% 
  gt() %>% 
  cols_align(
    align = "center") %>% 
   tab_header(
    title = md("Season Leaderboard (Season Percent)"),
    subtitle = md(glue("Week {length(weeks)}"))
    ) %>% 
  # fmt_icon(
  #   columns = `Donuts Won`,
  #   fill_color = "gold",
  # ) %>%
  tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`>.5
    ))%>% 
     tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`>.5
    )) %>% 
  tab_options(
    container.width = pct(100),
    data_row.padding = px(1),
    container.height = "100%"
   ) %>%
    tab_spanner(
    label = "Weekly # Correct",
    columns = starts_with(c("Week "))
  ) %>% 
  text_transform(
    locations = cells_body(c(`Season Trend`)),
    fn = function(x){
      map(season_leaderboard_disp$plot, ggplot_image, height = px(30), aspect_ratio = 4)
                 }) %>%
  cols_hide(columns = c(plot))
```

```{r Printing Adj Season Leaderboard, echo=FALSE}
# Printing the Adj Season Leaderboard
  
adj_season_leaderboard_disp = indiv_disp_2 %>% select(Name, starts_with("Week ")) %>% 
  pivot_longer(starts_with("Week"),names_to = "Week", values_to = "Correct") %>% 
  group_by(Week) %>% 
  mutate(Correct = case_when(is.na(Correct)==T~0, 
                             TRUE~Correct)) %>% 
  mutate(Donut = case_when(Correct==max(Correct)~1,
                           TRUE~0))  %>% 
  ungroup() %>% 
  group_by(Name) %>% 
  summarise(`Donuts Won` = sum(Donut)) %>% 
  #mutate(`Donuts Won` = strrep("award,", Donuts)) %>% 
  right_join(.,indiv_disp_2) %>% 
  select(-starts_with("Week "), -Percent) %>% 
  mutate(`Season Rank` = min_rank(desc(`Adj Season Percent`)),.before = Name) %>% 
  arrange(`Season Rank`)

adj_season_leaderboard = adj_season_leaderboard_disp %>% 
  gt() %>% 
  cols_align(
    align = "center") %>% 
   tab_header(
    title = md("Season Leaderboard (Adjusted Season Percent)"),
    subtitle = md(glue("Week {length(weeks)}"))
    ) %>% 
  # fmt_icon(
  #   columns = `Donuts Won`,
  #   fill_color = "gold",
  # ) %>%
  tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`>.5
    ))%>% 
     tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`>.5
    )) %>% 
  tab_options(
    container.width = pct(100),
    data_row.padding = px(1),
    container.height = "100%"
   ) %>%
    tab_spanner(
    label = "Weekly # Correct",
    columns = starts_with(c("Week "))
  ) %>% 
  text_transform(
    locations = cells_body(c(`Season Trend`)),
    fn = function(x){
      map(adj_season_leaderboard_disp$plot, ggplot_image, height = px(30), aspect_ratio = 4)
                 }) %>%
  cols_hide(columns = c(plot))
```


```{r instructor formattable, echo=FALSE}
improvement_formatter <- 
  formatter("span", 
            style = x ~ formattable::style(
              font.weight = "bold", 
              color = ifelse(x > .5, "green", ifelse(x < .5, "red", "black"))),
             x ~ icontext(ifelse(x == max(x), "star", ""), x))

indiv_disp_3 = indiv_disp_2 %>% select(-plot)
indiv_disp_3$`Season Trend` = apply(indiv_disp_3[,2:(1+length(weeks))], 1, FUN = function(x) as.character(htmltools::as.tags(sparkline(as.numeric(x), type = "line", chartRangeMin = 0, chartRangeMax = 1, fillColor = "white"))))

indiv_table_2 = as.htmlwidget(formattable(indiv_disp_3, 
                                align = c("l", rep("c", NROW(indiv_disp_3)-1)),
              list(`Season Percent` = color_bar("#FA614B"),
              `Season Percent`= improvement_formatter,
              `Adj Season Percent`= improvement_formatter)))
              
indiv_table_2$dependencies = c(indiv_table_2$dependencies, htmlwidgets:::widget_dependencies("sparkline", "sparkline"))
```

```{r Plotting individual results over the season2, eval=FALSE, include=FALSE, out.width="100%"}
#Creating the individual plot.  
inst_indiv_plots = weekly_indiv_percent_plot %>% 
  ggplot(aes(x = factor(Week), y = Percent, color = Name))+
  geom_point()+
  geom_path(aes(x = as.factor(Week), y = Percent, color = Name, 
                group = Name))+
  ylim(c(0, 1)) +
  labs(x = "NFL Week", 
       y = "Correct Percentage", 
       title = "Weekly Individual Correct Percentage")+
  facet_wrap(~Name)+
  theme_classic()+
  theme(legend.position = "none",
        plot.title = element_text(hjust = 0.5, size = 18),
        axis.text.x=element_text(angle =45, vjust = 1, hjust = 1))
```

```{r data for data page}
inst.data = map2(inst.picks, weeks, disp_data) %>% bind_rows()
```


```{r fivethirtyeight}
inst_538 = map(results, five38) %>% unlist() %>% sum()
```

```{r pregame, eval=FALSE, include=FALSE}
#Predictions for the week

#Creating the list of group predictions each week.
games = map(inst.picks, games_fn)

#Creating the prediction table.  
pred_table = map(games, pred_table_fn)

#Printing table of instructor predictions
pred_table[[length(pred_table)]] %>% mutate(Game = row_number()) %>% 
  rename(`Votes For` = votes_for, `Votes Against` = votes_against) %>% 
  gt() %>% 
  cols_align(
    align = "center") %>% 
   tab_header(
    title = md("This Week's Predictions"),
    subtitle = md(glue("Week {length(weeks)}"))
    ) %>% 
   tab_options(
    data_row.padding = px(3)
   )
```

Group Predictions
==========================================================================

Sidebar {.sidebar} 
-------------------------------------
#### CBS Sports

<font size="4">

This week we beat or tied `r cbs_experts_beat[[length(weeks)]]` of `r cbs_experts_total[[length(weeks)]]` CBS Sports' Experts.

For the season we are currently beating or tied with `r cbs_experts_beat_season[[length(weeks)]]` of `r cbs_experts_season_total[[length(weeks)]]` CBS Sports' Experts.
 
 </font>


#### ESPN

<font size="4">

We also beat or tied `r espn_experts_beat[[length(weeks)]]` of `r espn_experts_total[[length(weeks)]]` ESPN Experts.
 
For the season we are currently beating or tied with `r espn_experts_beat_season[[length(weeks)]]` of `r espn_experts_season_total[[length(weeks)]]` ESPN Experts.

</font>

Row
--------------------------------------

### Win percentage for the week

```{r}
inst_rate <- weekly_win_percentage[[length(weekly_win_percentage)]]*100
gauge(inst_rate, min = 0, max = 100, symbol = '%', gaugeSectors(
  success = c(55, 100), warning = c(40, 54), danger = c(0, 39)
))
```

### Season Win Percentage

```{r}
inst_season <- season_win_percentage*100
gauge(inst_season, min = 0, max = 100, symbol = '%', gaugeSectors(
  success = c(55, 100), warning = c(40, 54), danger = c(0, 39)
))
```

### Games Correct
```{r}
valueBox(value = season_wins,icon = "fa-trophy",caption = "Correct Games this Season")
```

### Games Picked
```{r}
valueBox(value = season_games,icon = "fa-clipboard-list",caption = "Games Picked this Season")
```

### Number of predictions
```{r}
valueBox(value = Total,icon = "fa-users",caption = "Predictions this week")
```

Row
--------------------------------------

### 

```{r}
inst_group_table
```

### 

```{r}
ggplotly(inst_group_season_plot) %>% 
  layout(title = list(y = .93, xref = "plot"),
         margin = list(t = 40))
```

Individual Predictions
==========================================================================


Sidebar {.sidebar} 
-------------------------------------

#### Best Picks of the Week.

<font size="4">

 `r indiv_winners`
 
 </font>
 
#### Best Season Correct Percentage
<font size="4">

`r indiv_season`
 
 </font>

#### Best Adjusted Season Correct Percentage
<font size="4">

`r indiv_season_adj`

 * Adjusted season percentage accounts for the number of weeks picked.
 
 </font>

row {.tabset}
--------------------------------------

### Individual Table
```{r, results='asis', error=FALSE}
indiv_table
```

<!--
### Individual Table2

```{r, out.height="100%"}
indiv_table_2
```

-->

<!--

### Individual Plots
```{r, out.width="100%"}
#ggplotly(inst_indiv_plots)
```

-->

### Season Leaderboard
```{r, results='asis', error=FALSE}
season_leaderboard
```

### Adjusted Season Leaderboard
```{r, results='asis', error=FALSE}
adj_season_leaderboard
```

Data
==========================================================================

```{r}
datatable(
  inst.data, extensions = 'Buttons', options = list(
    dom = 'Blfrtip',
    buttons = c('copy', 'csv', 'excel', 'pdf', 'print'),
    lengthMenue = list( c(10, 25, 50, 100, -1), c(10, 25, 50, 100, "All") )
  )
)
```